/* REXX _game_reporter.zrx by the reverend (build 73) */ /*- built by rev-builder version 1.1 on 13 Nov 2002 at 16:54:55 -*/ /*- ------------------------------------------------------------------------ -*/ /*- Copyright (C) 2001 Ron Wilson -*/ /*- -*/ /*- This script is free, and can be modified for your personal use, but you -*/ /*- cannot copy or distribute this script or any derivative work based upon -*/ /*- this script without the express permission of the author. Your use of -*/ /*- this script is governed by the terms of the REV-LICENSE. -*/ /*- -*/ /*- This program is provided to you WITHOUT ANY WARRANTY, even the implied -*/ /*- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -*/ /*- REV-LICENSE for more details. -*/ /*- -*/ /*- A copy of the REV-LICENSE is available at: -*/ /*- http://thereverend.coastgames.com/tradewars/rev-license.html -*/ /*- ------------------------------------------------------------------------ -*/ /* description: this script will monitor game information like the CD log, */ /* CLV screen, V screen, and # screen. it can do this at */ /* regular intervals, convert the information to html, and send */ /* the html to your webserver by ftp. */ /* rev. 0 - initial release */ /* rev. 1 - added html title */ /* rev. 2 - added the copyright notice, and made the header smaller */ /* rev. 3 - added TDL and TDR options, ansi converter upgrade */ /* rev. 4 - ansi converter bug fix, re-ordered log with V/CLV on top */ /* rev. 5 - added auto-relogin */ call zoctimeout 60 call zocsynctime 500 call on halt name _halt globals=_setglobals() call zockeyboard "LOCK" scriptname="_game_reporter.zrx" parse value arg(1) with arg.1 arg.2 arg.3 arg.4 . do i=1 to 4 arg.i=translate(arg.i," ","?") end if \arg(1,"E") then do if \_pcheck("Command [") then call _error "please start at the command prompt." end /*if*/ /* GET LOG INFO */ parse value _getloginfo() with lpath ";" ldefault parse value zocgetoption("VTStripSeq") with . '="' emulation '"' parse value zocgetglobaloption("ScriptPath") with . '="' spath '"' spath=spath||"\" /* CHECK FOR OBSERVER MODE */ observer=0 call zocsend "r" ans=zocwaitmux("This command not available to an Observer.",, "Marker Beacon here? (Y/N)",, "You do not have any Marker Beacons.",, "The Federation does not allow beacons") select when ans=0 then observer=1 when ans=1 then call zocsend "n" when ans=2 then nop when ans=3 then nop otherwise nop end /*select*/ /* REPORTING OPTIONS */ menu="timestamp (CD screen);player list (CLV screen);game status (V screen)" if \observer then menu=menu||";who's online (# screen);corp list (TDL screen);corp rank (TDR screen)" if \arg(1,"E") then optlist=_mrequestlist("pick one or more option:",menu,";","c") else optlist=arg.1 if optlist="##CANCEL##" then call _quit "script cancelled by user." timestamp=_dword(optlist,1,";") clvscreen=_dword(optlist,2,";") vscreen=_dword(optlist,3,";") if observer then do woscreen=0 tdlscreen=0 tdrscreen=0 end /*if*/ else do woscreen=_dword(optlist,4,";") tdlscreen=_dword(optlist,5,";") tdrscreen=_dword(optlist,6,";") end /*else*/ /* LOAD USER SETTINGS */ if \arg(1,"E") then iname=zocgetfilename("choose config file:",spath||"*.ini") else iname=arg.2 if iname="##CANCEL##" then exit call _newline _ansi("bt;fgr") if \arg(1,"E") then parse value _getgameinfo(iname) with spath ";" iname ";" game else game=arg.3 htmltitle=_ini_askstr("html title?", "untitled", iname, game, "htmltitle") htmlpath=_ini_askstr("where do put the html?", "c:\", iname, game, "localpath") if htmlpath="" then exit prefix=_ini_askstr("what file prefix?", "gameA", iname, game, "prefix") if prefix="" then exit interval=_ini_askint("how often to refresh (minutes)?", 60, iname, game, "interval") if interval=0 then exit if interval<2 then interval=2 loginmacro=_ini_askstr("##DEFAULT##", "", iname, game, "login_macro") gamepwd=_ini_askstr("game password?", "password", iname, game, "game_pwd") lname=lpath||"game_reporter_log.txt" address=_ini_askstr("address?", "", iname, "*ftp", "address") username=_ini_askstr("username?", "", iname, "*ftp", "username") password=_ini_askstr("password?", "", iname, "*ftp", "password") remotewd=_ini_askstr("remote working directory?", "", iname, "*ftp", "remotewd") mode=_ini_askstr("transfer mode?", "ascii", iname, "*ftp", "mode") if \arg(1,"E") then wmode=_chooselisti("ftp window?","normal;hidden;minimized;no ftp", ";", "c")-1 else wmode=arg.4 /* DEFINE HEADER */ infile=prefix||"_log.ans" hdr1="REV-SCRIPT - _game_reporter.zrx r.5 - " _g.1=loginmacro _g.2=gamepwd _g.3=iname _g.4=game _g.5=lname _g.6=optlist _g.7=wmode /* DISABLE MESSAGES */ call _twmsg "off" startover: /* ENTER COMPUTER MODE */ if \vscreen then do call zocsend "c" if zocwait("Computer command [")=640 then call _error "timeout" if zocwait("(?=Help)?")=640 then call _error "timeout" end /*do*/ call _newline /* START LOGGING TO INFILE */ call zoclogging 0, 1 if _fileexists(lpath||infile) then call dosdel lpath||infile call zocsetoption('VTStripSeq=no') call zoclogname infile call zoclogging 1, 1 /* WRITE HEADER TO LOG */ call zocwriteln _ansi("bt;frd")||hdr1||date("N")||", "||time("N")||", refresh every "||interval||" minutes."||_ansi("bt;fwh") /* WRITE V SCREEN TO LOG */ if vscreen then do call zocsend "v" if zocwait("(?=Help)?")=640 then call _error "timeout" end /*if*/ /* WRITE # SCREEN TO LOG */ if woscreen then do call zocsend "#" if zocwait("(?=Help)?")=640 then call _error "timeout" end /*if*/ /* ENTER COMPUTER MODE */ if vscreen then do call zocsend "c" if zocwait("Computer command [")=640 then call _error "timeout" if zocwait("(?=Help)?")=640 then call _error "timeout" end /*do*/ /* WRITE CLV SCREEN TO LOG */ if clvscreen then do call zocsend "lv" if zocwait("Computer command")=640 then call _error "timeout" if zocwait("(?=Help)?")=640 then call _error "timeout" end /*if*/ /* WRITE CD SCREEN TO LOG */ call zocsend "d" if zocwait("to read from. Today is")=640 then call _error "timeout" if zocwait("^M")=640 then call _error "timeout" date=strip(_lastline()) call zocrespond "[Pause]", "^M" if timestamp then call zocsend date||"^My" else call zocsend date||"^Mn" if zocwait("Computer command")=640 then call _error "timeout" if zocwait("(?=Help)?")=640 then call _error "timeout" call zocrespond "[Pause]" /* EXIT COMPUTER MODE */ call zocsend "q" if zocwait("")=640 then call _error "timeout" if zocwait("(?=Help)?")=640 then call _error "timeout" /* WRITE TDL AND TDR SCREENS */ if tdlscreen | tdrscreen then do call zocsend "t" if zocwait("Corporate command")=640 then call _error "timeout" if tdlscreen then do call zocsend "dl" if zocwait("TW2002 Corporate Listings")=640 then call _error "timeout" if zocwait("Corporate command")=640 then call _error "timeout" end /*if*/ if tdrscreen then do call zocsend "dr" if zocwait("TW2002 Corporate Listings")=640 then call _error "timeout" if zocwait("Corporate command")=640 then call _error "timeout" end /*if*/ call zocsend "q" if zocwait("Command [")=640 then call _error "timeout" if zocwait("(?=Help)?")=640 then call _error "timeout" end /*if*/ /* STOP LOGGING TO INFILE */ call zoclogging 0, 1 call zoclogname ldefault call zoclogging 1, 1 call zocsetoption('VTStripSeq='||emulation) /* CONVERT LOG ANSI TO HTML */ outfile=prefix||"_"||translate(date,"_","/")||".html" call _ansi_to_html lpath||infile, htmlpath||outfile, "REV-SCRIPT - "||htmltitle /* FTP TO WEBSERVER */ if wmode<3 then do call zocwrite "ftp in progress ... " if _ftp(address, username, password, , remotewd, mode, htmlpath, outfile, wmode) then call zocwriteln "SUCCESS!" else call zocwriteln "FAILED!" end /*if*/ /* WAIT FOR NEXT INTERVAL */ now=_getservertime("minutes")+1 stop=(now%interval)*interval+interval if (stop-now)<2 then stop=stop+interval done=0 do while \done if now>=stop | (stop-now)>=1440 then done=1 else do delay=min(30,trunc(((stop-now)//1440)*60)) hh=trunc(((stop-now)//1440)/60) if hh<10 then hh="0"||hh mm=trunc(((stop-now)//1440)-hh*60) if mm<10 then mm="0"||mm ss=trunc((((stop-now)//1440)//1)*60) if ss<10 then ss="0"||ss call zocwrite _ansi("bt;fwh")||"< refresh in "||hh||":"||mm||":"||ss||" > " call zocdelay delay now=_getservertime("minutes")+1 end /*else*/ end /*do*/ signal startover exit _halt: procedure expose (globals) call zocwriteln "^M^J^[[1;33m<< script aborted by user. >>^[[0;35m " call zocsetoption('VTStripSeq='||emulation) call _twmsg "on" exit return _error: procedure expose (globals) if zocgetinfo("CURSOR-X")>0 then call zocwriteln call zocwrite _ansi("bt;frd")||"< script error" if arg(1,"E") then call zocwrite ": "||arg(1) call zocwriteln " >" call zocwriteln _ansi("bt;fye")||"< if this is a serious problem, email me at: the.reverend@coastgames.com > " call zocwriteln "< ZOC VERSION '"||zocgetinfo("VERSION")||"', OS '"||zocgetinfo("OSYS")||"', LOCATION '"||zocgetinfo("CONNECTEDTO")||"' >" if arg(2,"E") then call zocwriteln _ansi("bt;fgr")||"< "||arg(2)||" >" call zocwrite _ansi() call _beep "error.wav" if _g.1\="" scriptname\="" & arg(1)="timeout" then do /* call zocdisconnect */ call zocwriteln _ansi("bt;fwh")||"< ATTEMPTING TO RECONNECT >" call _domacro _g.1 ans=0 do while ans=0 ans=zocwaitmux("[Pause]", , "Enter your choice:") select when ans=0 then call zocsend "^M" when ans=1 then do call zoctimeout 60 call _login _g.2, "game_reporter", 0, _g.3, _g.4, _g.5, 0 call zoctimeout 15 call zocdostring "^RUN="||scriptname _g.6 translate(_g.3,"?"," ") translate(_g.4,"?"," ") _g.7 exit end /*when*/ when ans=640 then call _error "timeout" otherwise nop end /*select*/ end /*do*/ end /*if*/ exit /*** THE REVEREND'S TW LIBRARY FOR ZOC/REXX ***/ /** _setglobals v.3 **/ _setglobals: procedure expose _verbose _monthdays _monthnames _baseday. (globals) _verbose=0 _monthdays="31;28;31;30;31;30;31;31;30;31;30;31" _monthnames="jan;feb;mar;apr;may;jun;jul;aug;sep;oct;nov;dec" _baseday.2000=730118 _baseday.2001=_baseday.2000+365+1 _baseday.2002=_baseday.2001+365 _baseday.2003=_baseday.2002+365 _baseday.2004=_baseday.2003+365 _baseday.2005=_baseday.2004+365+1 _baseday.2006=_baseday.2005+365 _baseday.2007=_baseday.2006+365 _baseday.2008=_baseday.2007+365 rslt="_g. _s. _p. _d. _v. _f. _m. _q. " rslt=rslt||"_ef. _es. _et. _ep. " rslt=rslt||"_path. _dist. _dtomsl. _dfrmsl. " rslt=rslt||"_bg. _nwi. _od. _sv. _pv. _bust. _vs. _vn. " rslt=rslt||"_olist1. _olist2. _clvlist1. _clvlist2. " rslt=rslt||"_verbose _monthdays _monthnames _baseday. " rslt=rslt||"globals reconnect scriptname lra " if arg(1,"E") then rslt=rslt||arg(1) rslt=_space(rslt) return rslt /** _pcheck v.4 **/ _pcheck: procedure expose (globals) pc1=arg(1) pc2=zocgetscreen(0, zocgetinfo("CURSOR-Y"), zocgetinfo("CURSOR-X")) rslt=0 do i=1 to _dwords(pc1,";") if _instr(_dword(pc1,i,";"),pc2,"cs") then rslt=1 end /*do*/ return rslt /** _getloginfo v.2 **/ _getloginfo: procedure expose (globals) parse value zocgetoption("CaptDefaultName") with . '="' ldefault '"' parse value zocgetglobaloption("CapturePath") with . '="' lpath '"' lpath=dosfname(lpath) if right(lpath,1)\="\" then lpath=lpath||"\" if \dosisdir(lpath) then call _error "invalid path in _getloginfo" rslt=lpath||";"||ldefault return rslt /** _mrequestlist v.3 **/ _mrequestlist: procedure expose (globals) do i=1 to 3 if \arg(i,"E") then call _error "missing parameter in _mrequestlist" end /*do*/ msg=arg(1) list=arg(2) if list="" then call _error "empty list in _mrequestlist" delim=arg(3) if arg(4,"E") then mode=arg(4) else mode="" if arg(5,"E") then default=arg(5) else default="" yes="> " no=" " if default="" then do rslt=0 menu=" DONE"||delim||no||_dword(list,1,delim) count=_dwords(list,delim) end /*if*/ else do rslt=_dword(default,1,delim) if rslt then menu=" DONE"||delim||yes||_dword(list,1,delim) else menu=" DONE"||delim||no||_dword(list,1,delim) count=min(_dwords(list,delim),_dwords(default,delim)) end /*else*/ if count>1 then do do i=2 to count if default="" then flag=no else do if _dword(default,i,delim) then flag=yes else flag=no end /*else*/ menu=menu||delim||flag||_dword(list,i,delim) if default="" then rslt=rslt||delim||0 else rslt=rslt||delim||_dword(default,i,delim) end /*do*/ end /*if*/ i=_drequestlisti(msg,menu,delim) do while i>1 menu=" DONE" temp="" do j=1 to _dwords(list,delim) if j=(i-1) then do if _dword(rslt,j,delim) then do menu=menu||delim||no||_dword(list,j,delim) if temp="" then temp=0 else temp=temp||delim||0 end /*if*/ else do menu=menu||delim||yes||_dword(list,j,delim) if temp="" then temp=1 else temp=temp||delim||1 end /*else*/ end /*if*/ else do if temp="" then temp=_dword(rslt,j,delim) else temp=temp||delim||_dword(rslt,j,delim) if _dword(rslt,j,delim) then menu=menu||delim||yes||_dword(list,j,delim) else menu=menu||delim||no||_dword(list,j,delim) end /*else*/ end /*do*/ rslt=temp i=_drequestlisti(msg,menu,delim) end /*do*/ if lower(mode)="c" & i=0 then call _quit "script cancelled by user." dmax=_dwords(default,";") lmax=_dwords(list,";") if dmax>lmax then do do i=dmax+1 to lmax rslt=rslt||delim||_dword(default,i,";") end /*do*/ end /*if*/ return rslt /** _quit v.7 **/ _quit: procedure expose (globals) lcpy=1 arg1="" do i=1 to 2 /* manage arguments */ select when arg(i,"E") & lower(arg(i))="nocopy" then lcpy=0 when arg(i,"E") & arg1="" then arg1=arg(i) otherwise nop end /*select*/ end /*do*/ line=zocgetscreen(0, zocgetinfo("CURSOR-Y"), zocgetinfo("CURSOR-X")) select /* define message */ when lcpy & arg1="" then msg="^[[1;32m< end script >^[[0m^M^J"||line when \lcpy & arg1="" then msg="^[[1;32m< end script >^[[0m " when lcpy then msg="^[[1;32m^M^J< end script: "||arg1||" >^[[0m^M^J"||line when \lcpy then msg="^[[1;32m^M^J< end script: "||arg1||" >^[[0m " otherwise nop end /*select*/ call zocwrite msg select /* choose a beep */ when lower(arg1)="script cancelled by user." then call _beep "cancel.wav" otherwise call _beep "quit.wav" end /*select*/ exit return 1 /** _dword v.2 **/ _dword: procedure expose (globals) rslt=translate(word(translate(arg(1),arg(3)||" "," "||arg(3)),arg(2))," "||arg(3),arg(3)||" ") return rslt /** _newline v.2 **/ _newline: procedure expose (globals) if zocgetinfo("CURSOR-X")>0 then call zocwriteln arg(1) else call zocwrite arg(1) return /** _ansi v.3 **/ _ansi: procedure expose (globals) rslt="0" do i=1 to _dwords(arg(1),";") w=_dword(arg(1),i,";") select when w="dl" then rslt=rslt||";"||0 /* dull */ when w="bt" then rslt=rslt||";"||1 /* bright */ when w="ul" then rslt=rslt||";"||4 /* underlined */ when w="blk" then rslt=rslt||";"||5 /* blinking */ when w="fbk" then rslt=rslt||";"||30 /* black foreground */ when w="frd" then rslt=rslt||";"||31 /* red foreground */ when w="fgr" then rslt=rslt||";"||32 /* green foreground */ when w="fye" then rslt=rslt||";"||33 /* yellow foreground */ when w="fbl" then rslt=rslt||";"||34 /* blue foreground */ when w="fmg" then rslt=rslt||";"||35 /* magenta foreground */ when w="fcy" then rslt=rslt||";"||36 /* cyan foreground */ when w="fwh" then rslt=rslt||";"||37 /* white foreground */ when w="bbk" then rslt=rslt||";"||40 /* black background */ when w="brd" then rslt=rslt||";"||41 /* red background */ when w="bgr" then rslt=rslt||";"||42 /* green background */ when w="bye" then rslt=rslt||";"||43 /* yellow background */ when w="bbl" then rslt=rslt||";"||44 /* blue background */ when w="bmg" then rslt=rslt||";"||45 /* magenta background */ when w="bcy" then rslt=rslt||";"||46 /* cyan background */ when w="bwh" then rslt=rslt||";"||47 /* white background */ otherwise nop end /*select*/ end /*do*/ rslt="^[["||rslt||"m" return rslt /** _getgameinfo v.5 **/ _getgameinfo: procedure expose (globals) spath=_getscriptpath() base=spath||"script.ini" if arg(1,"E") then fname=arg(1) else fname=base parse value zocgetglobaloption("WindowTitle") with . '="' game '"' if fname\=base | game="" | game="%ZOCORHOST% %OPTIONS%" then do list=_ini_getheadings(fname) if list="##EOF##" then game="##EOF##" else do templist="" do i=1 to _dwords(list,";") temp=_dword(list,i,";") if left(temp,1)\="*" then do if templist="" then templist=temp else templist=templist||";"||temp end /*if*/ end /*do*/ list=templist game=_drequestlist("select a game:", list, ";", "c") end /*else*/ end /*do*/ call zocwrite _ansi("bt;fgr")||"< using " if length(fname)>17 then call zocwrite "..." call zocwriteln right(fname,min(length(fname),17))||" - ["||game||"] >" rslt=spath||";"||fname||";"||game return rslt /** _ini_askstr v.5 **/ _ini_askstr: procedure expose (globals) if \arg(1,"E") then msg="enter a number" else msg=arg(1) do i=2 to 5 if \arg(i,"E") then call _error "missing parameter in _ini_askstr" end /*do*/ default=arg(2) fname=arg(3) section=arg(4) key=arg(5) mode=lower(arg(6)) if section="##EOF##" then rslt="##EOF##" else rslt=_ini_read(fname, section, key) select when rslt="##EOF##" & msg="##DEFAULT##" then rslt=default when rslt="##EOF##" then rslt=_askstr(msg||" ("||key||"=)",default,"c") when mode="quiet" then nop when mode="" then do call zocwrite _ansi("bt;fgr")||"< using " if length(fname)>17 then call zocwrite "..." call zocwrite right(fname,min(length(fname),17))||" - " call zocwrite key||"="||left(translate(rslt,"~","^"),min(length(rslt),25)) if length(rslt)>25 then call zocwrite "..." call zocwriteln " >" end /*when*/ otherwise nop end /*select*/ return rslt /** _ini_askint v.5 **/ _ini_askint: procedure expose (globals) if \arg(1,"E") then msg="enter an integer" else msg=arg(1) do i=2 to 5 if \arg(i,"E") then call _error "missing parameter in _ini_askint" end /*do*/ default=arg(2) fname=arg(3) section=arg(4) key=arg(5) mode=lower(arg(6)) if _stripint(default)\=default then call _error "invalid parameter in _ini_askint" if section="##EOF##" then rslt="##EOF##" else rslt=_ini_read(fname, section, key) select when rslt="##EOF##" & msg="##DEFAULT##" then rslt=_stripint(default) when rslt="##EOF##" then rslt=_askint(msg||" ("||key||"=)",default,"c") when mode="quiet" then rslt=_stripint(rslt) when mode="" then do call zocwrite _ansi("bt;fgr")||"< using " if length(fname)>17 then call zocwrite "..." call zocwriteln right(fname,min(length(fname),17))||" - "||key||"="||rslt||" >" rslt=_stripint(rslt) end /*when*/ otherwise nop end /*select*/ return rslt /** _chooselisti v.2 **/ _chooselisti: procedure expose (globals) prompt=arg(1) list=arg(2) if list="" then call _error "no list" delim=arg(3) if delim="" then delim=" " if length(delim)>1 then call _error "long delimiter" ch.="" i=_dwords(list,delim) do j=1 to i ch.j=_dword(list,j,delim) end /*do*/ if i<7 then max=1 if i<5 then max=0 if i>=7 then max=(i-5)%2+1 done=0 pos=0 do while \done if pos<0 then pos=0 if pos>max then pos=max select when pos=0 then do if max=0 then ans=zocrequest(prompt, ch.1, ch.2, ch.3, ch.4) else ans=zocrequest(prompt, ch.1, ch.2, ch.3, "next") end /*when*/ when pos=max then do p1=(pos-1)*2+4 p2=p1+1 p3=p1+2 ans=zocrequest(prompt, "back", ch.p1, ch.p2, ch.p3) end /*when*/ otherwise do p1=(pos-1)*2+4 p2=p1+1 ans=zocrequest(prompt, "back", ch.p1, ch.p2, "next") end /*otherwise*/ end /*select*/ select when ans="next" then pos=pos+1 when ans="back" then pos=pos-1 when ans="##CANCEL##" then done=1 when ans="" then nop otherwise done=1 end /*select*/ end /*do*/ rslt=0 do j=1 to i if ans=ch.j then do rslt=j leave end /*if*/ end /*do*/ if lower(arg(4))="c" & ans="##CANCEL##" then call _quit "script cancelled by user.", "nocopy" return rslt /** _twmsg v.2 **/ _twmsg: procedure expose (globals) if arg(1)="" then call _error "missing parameter." select when lower(arg(1))="on" then do msg1="Silencing" msg2="Displaying all messages" end /*when*/ when lower(arg(1))="off" then do msg1="Displaying" msg2="Silencing all messages" end /*when*/ otherwise call _error "invalid parameter." end /*select*/ call zocrespond msg1, "|" call zocsend "|" if zocwait(msg2)=640 then call _error "timeout" call zocrespond msg1 return /** _fileexists v.3 **/ _fileexists: procedure expose (globals) if \arg(1,"E") then call _error "missing parameter in _fileexists" if stream(arg(1), "C", "QUERY EXISTS")="" then rslt=0; else rslt=1 return rslt /** _lastline v.3 **/ _lastline: procedure expose (globals) rslt=zoclastline() select when lower(arg(1))="raw" then nop when pos(d2c(7),rslt)>0 then rslt=translate(zocstring("REMOVE", rslt, d2c(7))," ",d2c(0)||d2c(10)) otherwise rslt=translate(rslt," ",d2c(0)||d2c(10)) end /*select*/ return rslt /** _ansi_to_html v.4 **/ _ansi_to_html: procedure expose (globals) do i=1 to 2 if arg(i,"O") | \arg(i,"E") then call _error "missing parameter in _ansi_to_html" end /*do*/ infile=arg(1) outfile=arg(2) if arg(3,"E") then title=arg(3) else title="REV-SCRIPT" success=0 /* define constants */ esc=d2c(27) cr=d2c(13) lf=d2c(10) fface='Terminal' fsize=2 /* define colors */ color.="" color.30='#000000' /* black */ color.31='#6A0000' /* red */ color.32='#006A00' /* green */ color.33='#6A6A00' /* yellow */ color.34='#00006A' /* blue */ color.35='#800080' /* magenta */ color.36='#006A6A' /* cyan */ color.37='#A0A0A0' /* white */ color.130='#A0A0A0' color.131='#D40000' color.132='#00FF00' color.133='#D4D400' color.134='#0000D4' color.135='#D400D4' color.136='#00D4D4' color.137='#FFFFFF' do i=30 to 37 temp=i+10 color.temp=color.i temp=i+110 color.temp=color.i end /*do*/ /* initialize colors */ reset=1 bright=0 /* 1 */ underline=0 /* 4 */ blink=0 /* 5 */ reverse=0 /* 7 */ hidden=0 /* 8 */ bg=30 fg=37 /* initialize counters */ incode=0 count=0 ignore=0 lastspace=1 html="" if _fileopenr(infile) then do if _filenew(outfile,"delete") then do call _newline call zocwrite _ansi("bt;fwh;bbk")||'writing file: "'||outfile||'" ' mon=_spinner(0,25) call lineout outfile, ''||title||'' call lineout outfile, '' call lineout outfile, '' call charout outfile, '' do while \_fileeof(infile) ch=charin(infile) select when ch=esc then do mon=_spinner(mon,25) incode=1 count=count+1 codes="" end /*when*/ when incode & \_in("0123456789;[",ch) then do incode=0 select when ch="H" then do /* esc[;H positions cursor at row, col */ call charout outfile, "" ignore=ignore+1 end /*when*/ when ch="f" then do /* esc[;f positions cursor at row, col */ call charout outfile, "" ignore=ignore+1 end /*when*/ when ch="A" then do /* esc[A - moves cursor up n lines */ call charout outfile, "" ignore=ignore+1 end /*when*/ when ch="B" then do /* esc[B - moves cursor down n line(s) */ do i=1 to _dword(codes,1,";") call charout outfile, "
" end /*do*/ end /*when*/ when ch="C" then do /* esc[C - moves cursor right n column(s) */ do i=1 to _dword(codes,1,";") call charout outfile, " " end /*do*/ end /*when*/ when ch="D" then do /* esc[D - moves cursor left n column(s) */ call charout outfile, "" ignore=ignore+1 end /*when*/ when ch="s" then do /* esc[s - saves current position */ call charout outfile, "" ignore=ignore+1 end /*when*/ when ch="u" then do /* esc[u - restores saved position */ call charout outfile, "" ignore=ignore+1 end /*when*/ when ch="J" then do /* esc[J - clears the screen for any integer n */ call charout outfile, "
" ignore=ignore+1 end /*when*/ when ch="K" then do /* esc[K - clears from cursor to eoln */ call charout outfile, "" ignore=ignore+1 end /*when*/ when ch="h" then do /* esc[h - changes display mode */ call charout outfile, "" ignore=ignore+1 end /*when*/ when ch="l" then do /* esc[l - changes display mode */ call charout outfile, "" ignore=ignore+1 end /*when*/ when ch="m" then do /* esc[m - changes text and background color */ do i=1 to _dwords(codes,";") c=_dword(codes,i,";") select when c=0 then do reset=1 bright=0 /* 1 */ underline=0 /* 4 */ blink=0 /* 5 */ reverse=0 /* 7 */ hidden=0 /* 8 */ bg=40 fg=37 end /*when*/ when c=1 then bright=1 when c=4 then underline=1 when c=5 then blink=1 when c=7 then reverse=1 when c=8 then hidden=1 when c>=30 & c<=37 then do fg=c reset=0 end /*when*/ when c>=40 & c<=47 then bg=c otherwise nop end /*select*/ end /*do*/ if bright & \reset then fg=(fg//100)+100 if hidden then visibility="hidden" else visibility="visible" select when blink then textdec="blink" when underline then textdec="underline" otherwise textdec="none" end /*select*/ bg1=bg fg1=fg if reverse then do bg1=(87-(bg//100))+100 fg1=(67-(fg//100))+100 end /*if*/ html='' end /*if*/ otherwise do call charout outfile, "" ignore=ignore+1 end /*otherwise*/ end /*select*/ end /*when*/ when incode & ch\="[" then codes=codes||ch when \incode then do ch=translate(ch,"¦¦¦¦¦¦¦++¦¦++++++--+-+¦¦++--¦-+----++++++++¦_¦¦¯", , "°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞß") if html\="" & ch\=lf then call charout outfile, html html="" select when ch=lf then nop when ch=cr then do call lineout outfile, "
" lastspace=1 end /*when*/ when ch="<" then call charout outfile, "<" when ch=">" then call charout outfile, ">" when ch="&" then call charout outfile, "&" when ch='"' then call charout outfile, """ when ch=" " & lastspace then call charout outfile, " " when ch=" " then do call charout outfile, " " lastspace=1 end /*when*/ otherwise call charout outfile, ch end /*select*/ if ch\=" " & ch\=cr & ch\=lf then lastspace=0 end /*when*/ otherwise nop end /*select*/ end /*do*/ call lineout outfile, "

" call lineout outfile, '
Copyright (C) 2001 Ron Wilson
' call lineout outfile, '
REV-LICENSE
' call charout outfile, "" call _fileclose outfile call zocwriteln d2c(27)||"[1D." call zocwriteln " "||count||" ansi codes converted." call zocwriteln " "||ignore||" ansi codes discarded." success=1 end /*if*/ else call zocwriteln 'unable to create file: "'||outfile||'"' call _fileclose infile end /*if*/ else call zocwriteln 'unable to open file: "'||infile||'"' return success /** _ftp v.2 **/ _ftp: procedure expose (globals) address=arg(1) username=arg(2) password=arg(3) remotewd=arg(4) mode=arg(5) fpath=arg(6) fname=arg(7) wmode=arg(8) if windowmode="" then windowmode=0 sname=_space(translate(left(address,min(10,length(address)))||fname," ","./\:"),0)||".txt" if _fileexists(fpath||sname) then call dosdel fpath||sname if _fileopenw(fpath||sname) then do call lineout fpath||sname, "open "||address call lineout fpath||sname, username call lineout fpath||sname, password call lineout fpath||sname, 'cd "'||remotewd||'"' call lineout fpath||sname, mode call lineout fpath||sname, 'put "'||fpath||fname||'"' call lineout fpath||sname, "quit" call _fileclose fpath||sname if _fileexists(fpath||sname) then rslt=zocexec('ftp "-s:'||fpath||sname||'"',wmode) else rslt=1 end /*if*/ else rslt=1 if rslt>0 then rslt=0 else rslt=1 return rslt /** _getservertime v.7 **/ _getservertime: procedure expose (globals) /* get real date/time values */ parse value date("N") with . . year parse value date("O") with . "/" month "/" day sod=time("S") doy=date("D") base=date("B") parse value time("N") with hr ":" mn ":" sc leapyear=abs((year//4=0)-1) base=base-_baseday.2000 base_sec=base*86400+sod /* get game date/time values */ if _g.!timediff="_G.!TIMEDIFF" then do if _sendwait("ct","(?=Help)? T")=640 then call _error "timeout" if zocwaitmux(", "||year+11, ", "||year+12, ", "||year+13)=640 then call _error "timeout" line=_lastline() call zocsend "q" parse var line g_hr ":" g_min ":" g_sec g_ampm . g_month g_day ", " g_year . g_year=g_year-12 if g_ampm="PM" & g_hr\=12 then g_hr=g_hr+12 g_month=lower(g_month) do i=12 to 1 by -1 if g_month=_dword(_monthnames,i,";") then leave end /*do*/ g_month=i parse value _calc_base_date(g_year, g_month, g_day, g_hr, g_min, g_sec) with g_base ";" g_doy ";" g_sod ";" g_base_sec _g.!timediff=base_sec-g_base_sec end /*if*/ else do g_base_sec=base_sec-_g.!timediff g_sod=g_base_sec//86400 g_base=g_base_sec%86400 do i=2000 to 2008 if (_baseday.i-_baseday.2000)<=g_base then g_year=i end /*do*/ g_doy=g_base-_baseday.g_year+_baseday.2000 end /*else*/ select when arg(1)="seconds" then rslt=g_sod when arg(1)="minutes" then rslt=g_sod%60 when arg(1)="hours" then rslt=g_sod%3600 when arg(1)="stamp_old" then rslt=g_year-2000||copies("0",3-length(g_doy))||g_doy||copies("0",5-length(g_sod))||g_sod when arg(1)="stamp" then rslt=g_base_sec otherwise rslt=g_base_sec end /*select*/ return rslt /** _beep v.2 **/ _beep: procedure expose (globals) select when arg(1,"O") then call zocwrite d2c(7) when _fileexists(arg(1)) then call zocplaysound arg(1) otherwise call zocwrite d2c(7) end /*select*/ return /** _domacro v.4 **/ _domacro: procedure expose (globals) list=arg(1) n=_dwords(list,"}") a="" mux=0 rslt=0 leav=0 do i=1 to n parse value _dword(list,i,"}") with c "{" s if c="s" then do s=_dword(s,mux+1,"|") if pos("_x",s)>0 then do s=zocstring("REMOVE",s,"_x") rslt=1 end /*if*/ if pos("_c",s)>0 then do s=zocstring("REMOVE",s,"_c") leav=1 end /*if*/ end /*if*/ c=strip(lower(c)) select when c="b" then call zocbeep s when c="d" then call zocdisconnect when c="l" | c="c" then a=s when c="r" & s="" then nop when c="r" & \_fileexists(s) then nop when c="r" then do call zocdostring "^RUN="||s exit end /*when*/ when c="s" & a\="" then do call zocconnect a do while \_isonline(15) call zocdisconnect call zocconnect a end /*do*/ call zocsend s mux=0 a="" end /*when*/ when c="s" then do call zocsend s mux=0 end /*when*/ when c="w" & a\="" then do call zocconnect a do while zocwait(s)=640 call zocdisconnect call zocconnect a end /*do*/ a="" end /*when*/ when c="w" then if zocwait(s)=640 then call _error "timeout" when c="m" then do mux=zocwaitmux(s) if mux=640 then call _error "timeout" end /*when*/ otherwise nop end /*select*/ if rslt then leave if leav then leave end /*do*/ return rslt /** _login v.3 **/ _login: procedure expose (globals) if \arg(1,"E") | \arg(2,"E") | \arg(3,"E") | \arg(4,"E") | \arg(5,"E") | \arg(6,"E") then call _error "missing parameter in _login" gamepwd=arg(1) cname=arg(2) bname=arg(3) iname=arg(4) gname=arg(5) lname=arg(6) if \arg(7,"E") then hide=1 else hide=arg(7) if \arg(8,"E") then ignorelist="" else ignorelist=arg(8) call _rseed call zoclogging 0, 1 call zoclogname cname||"_log_^3^2^1_^8.txt" call zocsetoption 'CaptDefaultName="'||cname||'_log_^3^2^1_^8.txt"' call zoclogging 1, 1 call zocsend "t^M" mode=0 /* 0=initial 1=logs 2=returning 3=new */ newname="" done=0 pset=0 pflag=1 lg_i=0 do while \done select when mode=0 then ans=zocwaitmux("[Pause]",, "Show today's log? (Y/N) [N]",, "Include time/date stamp? (Y/N) [N]",, " Hello ",, "Password?",, "messages received since your last",, "new character",, "destroyed your ship today...") when mode=1 then ans=zocwaitmux("[Pause]",, "No messages received.",, "> ",, "::",, "/14:",, "/15:",, "entered sector.",, "Sub Space Ether Probe.",, "I.D. code.",, "disrupted all of your mines in ",, "Delete messages? (Y/N) [N]") when mode=2 then ans=zocwaitmux("[Pause]",, "Do you wish to clear some avoids? (Y/N) [N]",, "(?=Help)? :",, "Planet command (?=help) [D]",, "Option? (A,D,I",, "Class 9 (Special)",, "Sector : 1 in",, "What do you want to name your ship? (30 letters)",, "Password?") when mode=3 then ans=zocwaitmux("[Pause]",, "Password?",, "Use (N)ew Name or (B)BS Name [B] ?",, "cannot use the name",, "That alias would look",, "name your ship?",, "name your home planet?",, "(?=Help)? :") end /*select*/ select when mode=0 & ans=0 then call zocsend " " when mode=0 & ans=1 then call zocsend "n" when mode=0 & ans=2 then call zocsend "y" when mode=0 & ans=3 then do bbsname=_grabit(", welcome") bbsname=left(bbsname,pos(", welcome",bbsname)-1) end /*when*/ when mode=0 & ans=4 then call zocsend gamepwd||"^M" when mode=0 & ans=5 then mode=1 when mode=0 & ans=6 then do call zocsend "y" mode=3 end /*when*/ when mode=0 & ans=7 then done=1 when mode=1 & ans=0 then do call zocdelay 1 select when _pcheck("[Pause] - [") & pflag then do call zocsend " " pflag=0 end /*when*/ when _pcheck("[Pause] - [") then nop when _pcheck("[Pause] - D") then do call zocsend "y" mode=2 end /*when*/ otherwise do call zocsend " " pflag=0 end /*otherwise*/ end /*select*/ end /*when*/ when mode=1 & ans=1 then mode=2 when mode=1 & ans=2 & \pflag then pflag=1 when mode=1 & ans=2 then nop when mode=1 & ans=3 then do line=_lastline() parse var line brand "-" typ " : " cmd . sect . stamp . if typ="CMD" & bname\=0 then call _bust_tool cmd, sect, stamp, bname end /*when*/ when mode=1 & ans<=5 then do line=_lastline() parse var line . " at " lg_hr ":" lg_mn ":" lg_sc lg_ampm " S.D. " lg_ds ":" if lg_ampm="PM" & lg_hr<12 then lg_hr=lg_hr+12 lg_ts=lg_hr||":"||lg_mn||":"||lg_sc lg_stamp=lg_ds||", "||lg_ts end /*when*/ when mode=1 & ans=6 then do /* entered sector. */ line=_lastline() parse var line "Report Sector " lg_sect ": " lg_name " entered sector." lg_player=left(lg_name,lastpos("'s",lg_name)-1) lg_ship=substr(lg_name,lastpos("'s",lg_name)+3) lg_sect=_stripint(lg_sect) if lg_sect\="" & \_listinstr(ignorelist, lg_player) then do lg_i=lg_i+1 lg_list.lg_i=lg_sect||copies(" ",5-length(lg_sect))||": "||lg_stamp||" - ENTER "||lg_player||" ("||_abbrv_words(lg_ship,3)||")" end /*if*/ end /*when*/ when mode=1 & ans=7 then do /* probe */ line=_lastline() parse var line . "sector " lg_sect . lg_sect=_stripint(lg_sect) pflag=1 end /*when*/ when mode=1 & ans=8 then do /* probe traced */ line=_lastline() parse var line . "to " lg_player "'s I.D. code." . if lg_sect\="" & \_listinstr(ignorelist, lg_player) then do lg_i=lg_i+1 lg_list.lg_i=lg_sect||copies(" ",5-length(lg_sect))||": "||lg_stamp||" - PROBE "||lg_player end /*if*/ end /*when*/ when mode=1 & ans=9 then do line=_lastline() lg_sect=_stripint(_grabit("^M")) parse var line lg_player " disrupted all " . if lg_sect\="" & \_listinstr(ignorelist, lg_player) then do lg_i=lg_i+1 lg_list.lg_i=lg_sect||copies(" ",5-length(lg_sect))||": "||lg_stamp||" - DISRUPT "||lg_player end /*if*/ end /*when*/ when mode=1 & ans=10 then do call zocsend "y" mode=2 end /*when*/ when mode=2 & ans=0 then call zocsend " " when mode=2 & ans=1 then call zocsend "n" when mode=2 & ans=2 then do call zocsend "zn" done=1 end /*when*/ when mode=2 & ans=3 then do call zocsend "c" done=1 end /*when*/ when mode=2 & ans=4 then done=1 when mode=2 & ans=5 then do if hide then do if _sendwait(" psgyg","")=640 then call _error "timeout" done=1 end /*if*/ end /*when*/ when mode=2 & ans=6 then do if hide then do if _sendwait(" l1^M","colonists ready")=640 then call _error "timeout" done=1 end /*if*/ end /*when*/ when mode=2 & ans=7 then call zocsend "Merchant Marines^My" when mode=2 & ans=8 then do gamepwd=_askstr("what password for this game?",gamepwd,"c") if \_ini_write(iname,gname,"game_pwd",gamepwd) then call _error "unable to write to "||iname call zocsend gamepwd||"^M" end /*when*/ when mode=3 & ans=0 then call zocsend " " when mode=3 & ans=1 & \pset then do gamepwd=_askstr("what password for this game?",gamepwd,"c") call zocsend gamepwd||"^M" if \_ini_write(iname,gname,"game_pwd",gamepwd) then call _error "unable to write to "||iname pset=1 end /*when*/ when mode=3 & ans=1 then call zocsend gamepwd||"^M" when mode=3 & ans=2 then do newname=_askstr("what name for this game?",bbsname,"c") if newname=bbsname then call zocsend "b" else call zocsend "n"||newname||"^M" end /*when*/ when mode=3 & ans=3 then do newname=_askstr("what name for this game?",newname||random(1,100),"c") call zocsend newname||"^M" end /*when*/ when mode=3 & ans=4 then call zocsend "y" when mode=3 & ans=5 then do if newname="" then newname=bbsname shipname=_askstr("what name for your ship?","Merchant Marines","c") call zocsend shipname||"^My" end /*when*/ when mode=3 & ans=6 then do planetname=_askstr("what name for this planet?",newname||"'s home planet","c") call zocsend planetname||"^Mq" end /*when*/ when mode=3 & ans=7 then do /* get stardock */ sd="" call zocsend "v" ans2=zocwaitmux("The StarDock is located in sector","Photon Missile Wave duration") select when ans2=0 then sd=_stripint(_grabit(".")) when ans2=1 then nop when ans2=640 then call _error "timeout" otherwise nop end /*select*/ /* turn off animations */ call zocsend "cn2qq" /* get ship catalog */ call _set_ship_catalog /* write other settings to script.ini */ call zocwrite _ansi("bt;fwh")||"writing settings." if \_ini_write(iname,gname,"player_name",newname) then call _error "unable to write to "||iname call zocwrite "." if \_ini_write(iname,gname,"sd",sd) then call _error "unable to write to "||iname call zocwrite "." if \_ini_write(iname,gname,"log_ignore","") then call _error "unable to write to "||iname call zocwrite "." if \_ini_write(iname,gname,"rylos","") then call _error "unable to write to "||iname call zocwrite "." if \_ini_write(iname,gname,"alpha","") then call _error "unable to write to "||iname call zocwrite "." /* build ship catalog */ /* setshortname */ /* set other script.ini stuff */ done=1 end /*when*/ when ans=640 then call _error "timeout" otherwise nop end /*select*/ end /*do*/ if _fileopenw(lname) then do do i=1 to lg_i call lineout lname, lg_list.i end /*do*/ call _fileclose lname end /*if*/ return /** _space v.1 **/ _space: procedure expose (globals) str=strip(arg(1)) if arg(2,"E") then n=arg(2); else n=1 if arg(3,"E") then pad=arg(3); else pad=" " rslt=word(str,1) do i=2 to words(str) rslt=rslt||copies(pad,n)||word(str,i) end /*do*/ return rslt /** _dwords v.2 **/ _dwords: procedure expose (globals) rslt=words(translate(arg(1),arg(2)||" "," "||arg(2))) return rslt /** _instr v.3 **/ _instr: procedure expose (globals) fnd=arg(1) str=arg(2) if lower(arg(3))\="cs" then do fnd=lower(fnd) str=lower(str) end /*if*/ if arg(1,"E") & arg(2,"E") & pos(fnd,str)>0 then rslt=1 else rslt=0 return rslt /** _drequestlisti v.2 **/ _drequestlisti: procedure expose (globals) do i=1 to 3 if \arg(i,"E") then call _error "missing parameter in _drequestlisti" end /*do*/ i=zocrequestlist(arg(1),translate(arg(2),"|"||arg(3),arg(3)||"|")) if i<0 & lower(arg(4))="c" then call _quit "script cancelled by user.", "nocopy" else rslt=i+1 return rslt /** _getscriptpath v.1 **/ _getscriptpath: parse value zocgetglobaloption("ScriptPath") with . '="' spath '"' spath=dosfname(spath) if right(spath,1)\="\" then spath=spath||"\" if \dosisdir(spath) then call _error "invalid path in _getscriptpath" return spath /** _ini_getheadings v.5 **/ _ini_getheadings: procedure expose (globals) if arg(1,"E") then fname=arg(1) else call _error "missing parameter in _ini_getheadings" if arg(2,"E") then delim=left(arg(2),1) else delim=";" list="" if _fileopenr(fname) then do do while \_fileeof(fname) line=strip(linein(fname)) if left(line,1)="[" then do if list="" then list=strip(translate(line," ","[]")) else list=list||delim||strip(translate(line," ","[]")) end /*if*/ end /*do*/ call _fileclose fname end /*do*/ if list="" then list="##EOF##" return list /** _drequestlist v.3 **/ _drequestlist: procedure expose (globals) i=zocrequestlist(arg(1),translate(arg(2),"|"||arg(3),arg(3)||"|")) select when i<0 & lower(arg(4))="c" then call _quit "script cancelled by user.", "nocopy" when i<0 then rslt="##CANCEL##" otherwise rslt=_dword(arg(2),i+1,arg(3)) end /*select*/ return rslt /** _ini_read v.1 **/ _ini_read: procedure expose (globals) /* argument check */ do i=1 to 3 if \arg(i,"E") | arg(i,"O") then call _error "missing arguments in _ini_read." end /*do*/ /* name arguments */ fname=arg(1) s=strip(arg(2)) k=strip(arg(3)) if _fileopenr(fname) then do done=0 found=0 insection=0 do while \done & \_fileeof(fname) line=strip(linein(fname)) select when left(line,1)=";" then nop when line="["||s||"]" then insection=1 when insection & left(line,1)="[" then done=1 when insection & left(line,length(k)+1)=k||"=" then do v=strip(substr(line,length(k)+2)) done=1 found=1 end /*when*/ otherwise nop end /*select*/ end /*do*/ call _fileclose fname if \found then v="##EOF##" end /*if*/ else v="##EOF##" return v /** _askstr v.1 **/ _askstr: procedure expose (globals) do i=1 to 3 select when i=1 & arg(i,"E") then msg=arg(i) when i=1 then msg="enter an string:" when i=2 & arg(i,"E") then default=arg(i) when i=2 then default="" when i=3 & arg(i,"E") then cflag=min(verify(lower(arg(i)),"c","M"),1) when i=3 then cflag=0 otherwise nop end /*select*/ end /*do*/ rslt=zocask(msg, default) if cflag & rslt="##CANCEL##" then call _quit "script cancelled by user.", "nocopy" return rslt /** _stripint v.4 **/ _stripint: procedure expose (globals) mask=_space(translate(arg(1)," ","-0123456789"," "),0) rslt=_space(translate(arg(1)," ",mask," "),0) if left(rslt,1)="-" then rslt="-"||_space(translate(rslt," ","-"),0) else rslt=_space(translate(rslt," ","-"),0) if \datatype(rslt,"W") then rslt="" return rslt /** _askint v.2 **/ _askint: procedure expose (globals) do i=1 to 3 select when i=1 & arg(i,"E") then msg=arg(i) when i=1 then msg="enter an integer:" when i=2 & arg(i,"E") then default=arg(i) when i=2 then default="" when i=3 & arg(i,"E") then cflag=min(verify(lower(arg(i)),"c","M"),1) when i=3 then cflag=0 otherwise nop end /*select*/ end /*do*/ rslt=strip(zocask(msg, default)) do while _stripint(rslt)\=rslt | rslt="" default=rslt||" [please enter an integer or ESC to cancel.]" if rslt="##CANCEL##" then leave else rslt=strip(zocask(msg, default)) end /*do*/ if cflag & rslt="##CANCEL##" then call _quit "script cancelled by user.", "nocopy" return rslt /** _fileopenr v.4 **/ _fileopenr: procedure expose (globals) if \arg(1,"E") then call _error "missing parameter in _fileopenr" if _fileexists(arg(1)) then do call stream arg(1), "C", "OPEN READ" rslt=_fileready(arg(1)) if \rslt then call _fileclose arg(1) end /*if*/ else rslt=0 return rslt /** _filenew v.4 **/ _filenew: procedure expose (globals) if \arg(1,"E") then call _error "missing parameter in _filenew" if arg(2,"E") & lower(arg(2))="delete" then call dosdel arg(1) if _fileexists(arg(1)) then rslt=0 else do call stream arg(1), "C", "OPEN WRITE" rslt=_fileready(arg(1)) if \rslt then call _fileclose arg(1) end /*else*/ return rslt /** _spinner v.3 **/ _spinner: procedure expose (globals) if arg(1,"E") then count=arg(1) else call _error "missing parameter in _spinner" if arg(2,"E") then width=arg(2) else width=100 if arg(3,"E") & length(arg(3))=5 then chs=arg(3) else chs="-\|/." /* bs="^H" */ bs=d2c(27)||"[1D" select when count=-1 then call zocwrite bs||substr(chs,5,1) when count<0 then count=-1 when count=0 then call zocwrite left(chs,1) when count=width then call zocwrite bs||substr(chs,2,1) when count=(width*2) then call zocwrite bs||substr(chs,3,1) when count=(width*3) then call zocwrite bs||substr(chs,4,1) when count=(width*4) then do call zocwrite bs||left(chs,1) count=0 end /*when*/ otherwise nop end /*select*/ count=count+1 return count /** _fileeof v.4 **/ _fileeof: procedure expose (globals) rslt=\lines(arg(1)) return rslt /** _in v.3 **/ _in: procedure expose (globals) if arg(1,"E") & arg(2,"E") & length(arg(1))>0 & verify(arg(2),arg(1),"N")=0 then rslt=1 else rslt=0 return rslt /** _fileclose v.3 **/ _fileclose: procedure expose (globals) if \arg(1,"E") then call _error "missing argument in _fileclose" call stream arg(1), "C", "CLOSE" return /** _fileopenw v.3 **/ _fileopenw: procedure expose (globals) if \arg(1,"E") then call _error "missing parameter in _fileopenw" if _fileexists(arg(1)) then do call stream arg(1), "C", "OPEN WRITE" call stream arg(1), "C", "SEEK <0" rslt=_fileready(arg(1)) if \rslt then call _fileclose arg(1) end /*if*/ else rslt=_filenew(arg(1)) return rslt /** _sendwait v.1 **/ _sendwait: procedure expose (globals) if \arg(1,"E") | \arg(2,"E") then call _error "missing parameter in _sendwait" call zocsend arg(1) rslt=zocwait(arg(2)) select when \arg(3,"E") | arg(3)="" then nop when lower(arg(3))="timeout" & rslt=640 then call _error "timeout" when lower(arg(3))="lastline" & rslt=640 then call _error "timeout" when lower(arg(3))="lastline" then rslt=_lastline() otherwise nop end /*select*/ return rslt /** _calc_base_date v.3 **/ /* v.3 tested */ _calc_base_date: procedure expose (globals) yr=arg(1); mm=arg(2); dd=arg(3); hr=arg(4); mn=arg(5); sc=arg(6) /* leapyear? */ leapyear=abs((yr//4=0)-1) /* day of year */ doy=dd-1 do i=1 to mm-1 doy=doy+_dword(_monthdays,i,";") end /*do*/ if mm>2 & leapyear then doy=doy+1 /* base day since 2000 */ base=_baseday.yr-_baseday.2000+doy /* seconds of day */ sod=((hr*60)+mn)*60+sc /* base day in seconds */ base_sec=base*86400+sod rslt=base||";"||doy||";"||sod||";"||base_sec return rslt /** _isonline v.3 **/ _isonline: procedure expose (globals) if zocgetinfo("ONLINE")="##YES##" then return 1 if arg(1,"E") then t=arg(1) else call _error "missing parameter in _isonline" rslt=0 o="##NO##" call time "R" do while time("E")<=t & o\="##YES##" o=zocgetinfo("ONLINE") if o="##YES##" then rslt=1 end /*do*/ return rslt /** _rseed v.7 **/ _rseed: procedure expose (globals) if arg(1,"E") then width=min(max(arg(1),2),86400) else width=1000 parse value time("L") with r1 ":" r2 ":" r3 "." r4 r4=strip(left(r4,5)) seed=r4||copies(0,5-length(r4)) rslt=random(0, 99999, seed)//width return rslt /** _grabit v.1 **/ _grabit: procedure expose (globals) if zocwait(arg(1))=640 then call _error "timeout" rslt=_lastline() return rslt /** _bust_tool v.1 **/ _bust_tool: procedure expose (globals) cmd=arg(1) sector=arg(2) stamp=arg(3) fname=arg(4) msg=cmd||" : "||copies(" ",5-length(sector))||sector||" : "||stamp if _fileopenw(fname) then do call lineout fname, msg call _fileclose fname end /*if*/ else call _error "unable to open file "||fname||"." return /** _listinstr v.3 **/ _listinstr: procedure expose (globals) if \arg(1,"E") | \arg(2,"E") then call _error "missing parameter in _listinstr" abbrlist=arg(1) archetype=arg(2) if arg(3,"E") then mode=arg(3) else mode="" if arg(4,"E") then delim=left(arg(4),1) else delim=";" if mode\="cs" then do abbrlist=lower(abbrlist) archetype=lower(archetype) end /*if*/ rslt=0 if archetype="" then rslt=1 else do do i=1 to _dwords(abbrlist,delim) if pos(_dword(abbrlist,i,delim), archetype)>0 then do rslt=1 leave end /*if*/ end /*do*/ end /*else*/ return rslt /** _abbrv_words v.1 **/ _abbrv_words: procedure expose (globals) rslt="" if \arg(2,"E") then len=4 else len=arg(2) do i=1 to words(arg(1)) w=word(arg(1),i) select when len<1 then nop when len=1 then rslt=rslt||" "||left(w,1) when len>2 then rslt=rslt||" "||left(w,1)||strip(left(_space(translate(substr(w,2)," ","aeiouAEIOU"),0),len-1)) otherwise nop end /*select*/ end /*do*/ rslt=strip(rslt) return rslt /** _ini_write v.3 **/ /*_ v.3 tested -*/ _ini_write: procedure expose (globals) /* argument check */ do i=1 to 4 if \arg(i,"E") | arg(i,"O") then call _error "missing arguments in _ini_write." end /*do*/ /* name arguments */ fname=arg(1) s=strip(arg(2)) k=strip(arg(3)) v=strip(arg(4)) tname=fname||".tmp" written=0 rslt=0 if _fileopenr(fname) then do if _fileexists(tname) then if \dosdel(tname) then call _error "file delete failed." if _fileopenw(tname) then do insection=0 linenum=0 do while \_fileeof(fname) line=strip(linein(fname)) linenum=linenum+1 select when line="["||s||"]" then do insection=1 if linenum>1 then call lineout tname, "" call lineout tname, line call charout tname, k||"="||v written=1 end /*when*/ when insection & left(line,length(k)+1)=k||"=" then nop when insection & left(line,1)="[" then do if linenum>1 then call lineout tname, "" call charout tname, line insection=0 end /*when*/ when line="" then do if linenum>1 then call lineout tname, "" call charout tname, "" end /*when*/ otherwise do if linenum>1 then call lineout tname, "" call charout tname, line end /*otherwise*/ end /*select*/ end /*do*/ if \written then do if linenum>1 then call lineout tname, "" call lineout tname, "["||s||"]" call charout tname, k||"="||v written=1 end /*if*/ call _fileclose(tname) end /*if*/ call _fileclose(fname) end /*if*/ if written then do if \dosdel(fname) then call _error "file delete failed." if \dosrename(tname,fname) then call _error "file rename failed." end /*if*/ else do if \_fileexists(fname) then do if _filenew(fname) then do call lineout fname, "["||s||"]" call charout fname, k||"="||v call _fileclose(fname) written=1 end /*if*/ end /*if*/ end /*else*/ return written /** _set_ship_catalog v.1 **/ _set_ship_catalog: procedure expose (globals) call _twmsg "OFF" call zocsend "cc" if zocwait("Which ship are you interested in (?=List) ?")=640 then call _error "timeout" /* setup ship array */ nextpage=0 ship.0=0 i=1 buflen=3*1024 done=0 do while \done /* read catalog page into buffer */ call zocreceivebuf buflen if i=1 then call zocsend "?" else call zocsend "+" if zocwait("Which ship are you interested in (?=List) ?")=640 then call _error "timeout" buff=translate(zocreceivebuf(buflen)," ",d2c(0)||d2c(10)) if length(buff)=buflen then call _error "buffer overflow" /* parse ship catalog page */ j=ship.0 jj=1 ii=pos("<",buff,jj) if ii>0 then jj=pos(d2c(13),buff,ii) do while ii>0 & jj>0 parse value substr(buff,ii,jj-ii) with "<" letter "> " shipname select when i>1 & letter="A" & shipname=_dword(ship.1,3,";") then do done=1 leave end /*when*/ when shipname="Next Page" then nextpage=1 when shipname="To Leave" then nop otherwise do j=j+1 ship.j=i||";"||letter||";"||shipname end /*otherwise*/ end /*select*/ ii=pos("<",buff,jj) if ii>0 then jj=pos(d2c(13),buff,ii) else jj=0 end /*do*/ ship.0=j if \nextpage then done=1 i=i+1 end /*do*/ currentpage=1 do i=1 to ship.0 mshlds=0 mfigs=0 mfigattack=0 offodds=0 defodds=0 /* get ship description */ parse var ship.i page ";" letter ";" shipname if page>currentpage then do currentpage=page call zocsend "+" if zocwait("Which ship are you interested in (?=List) ?")=640 then call _error "timeout" buff=translate(zocreceivebuf(buflen)," ",d2c(0)||d2c(10)) if length(buff)=buflen then call _error "buffer overflow" end /*if*/ call zocsend letter if zocwait("Which ship are you interested in (?=List) ?")=640 then call _error "timeout" buff=translate(zocreceivebuf(buflen)," ",d2c(0)||d2c(10)) if length(buff)=buflen then call _error "buffer overflow" line.i=_parse_ship_desc(buff) /* parse ship description ii=pos("Maximum Shields:",buff) if ii>0 then jj=pos(d2c(13),buff,ii) else jj=0 if ii>0 & jj>0 then parse value substr(buff,ii,jj-ii)with "Maximum Shields:" mshlds ii=pos("Max Fighters:",buff) if ii>0 then jj=pos("Offensive Odds:",buff,ii) else jj=0 if ii>0 & jj>0 then parse value substr(buff,ii,jj-ii) with "Max Fighters:" mfigs if jj>0 then kk=pos(":1",buff,jj) else kk=0 if jj>0 & kk>0 then parse value substr(buff,jj,kk-jj) with "Offensive Odds:" offodds ii=pos("Turns Per Warp:",buff) if ii>0 then jj=pos("Defensive Odds:",buff,ii) else jj=0 if ii>0 & jj>0 then parse value substr(buff,ii,jj-ii) with "Turns Per Warp:" tpw if jj>0 then kk=pos(":1",buff,jj) else kk=0 if jj>0 & kk>0 then parse value substr(buff,jj,kk-jj) with "Defensive Odds:" defodds ii=pos("Max Figs Per Attack:",buff) if ii>0 then jj=pos("TransWarp Drive:",buff,ii) else jj=0 if ii>0 & jj>0 then parse value substr(buff,ii,jj-ii) with "Max Figs Per Attack:" mfigattack ii=pos("Maximum Holds:",buff) if ii>0 then jj=pos("Transport Range:",buff,ii) else jj=0 if ii>0 & jj>0 then parse value substr(buff,ii,jj-ii) with "Maximum Holds:" mholds if jj>0 then kk=pos("Photon Missiles:",buff,jj) else kk=0 if jj>0 & kk>0 then parse value substr(buff,jj,kk-jj) with "Transport Range:" range mshlds=_space(translate(mshlds," ",","),0) mfigs=_space(translate(mfigs," ",","),0) mfigattack=_space(translate(mfigattack," ",","),0) offodds=strip(offodds) defodds=strip(defodds) mholds=strip(mholds) range=strip(range) tpw=strip(tpw) line.i=mshlds||";"||mfigs||";"||mfigattack||";"||offodds||";"||defodds||";"||mholds||";"||range||";"||tpw */ end /*do*/ /* exit ship catalog */ call zocsend "qq" if zocwaitmux("Command [","Citadel command")=640 then call _error "timeout" call _newline parse value _getgameinfo() with spath ";" iname ";" game call zocwrite _ansi("bt;fwh")||"writing ship catalog to "||iname||" ["||game||"] " do i=ship.0 to 1 by -1 call zocwrite "." if \_ini_write(iname,game,"ship."||strip(left(_dword(ship.i,3,";"),23)),line.i) then call _error "unable to write to "||iname end /*do*/ call zocwrite "." if \_ini_write(iname,game,"ship.key_long","shipbasecost;maxfigsperattack;maximumholds;initialholds;maxfighters;turnsperwarp;minemax;genesismax;transwarpdrive;transportrange;maximumshields;offensiveodds;defensiveodds;beaconmax;longrangescan;planetscanner;photonmissiles") then call _error "unable to write to "||iname if \_ini_write(iname,game,"ship.key","1bcst;2mfgpa;3mhlds;4ihlds;5mfg;6tpw;7mmine;8mgent;9tw;10trng;11mshlds;12offodds;13defodds;14mbeac;15lrs;16ps;17phot") then call _error "unable to write to "||iname call zocsend "|" if zocwaitmux("Command [","Citadel command")=640 then call _error "timeout" return /** _fileready v.1 **/ _fileready: procedure expose (globals) if \arg(1,"E") then call _error "missing parameter in _fileready" if stream(arg(1), "S")="READY" then rslt=1; else rslt=0 return rslt /* _parse_ship_desc v.1 */ _parse_ship_desc: procedure expose (globals) buff=arg(1) rslt="" i=pos("Basic Hold Cost:",buff) j=pos(d2c(13),buff,i) line.1=strip(substr(buff,i,j-i)) parse var line.1 . . . basicholdcost . . initialholds . . maximumshields . basicholdcost=_stripcomma(basicholdcost) maximumshields=_stripcomma(maximumshields) i=pos("Main Drive Cost:",buff,j+1) j=pos(d2c(13),buff,i) line.2=strip(substr(buff,i,j-i)) parse var line.2 . . . maindrivecost . . maxfighters . . offensiveodds . maindrivecost=_stripcomma(maindrivecost) maxfighters=_stripcomma(maxfighters) offensiveodds=_dword(offensiveodds,1,":") i=pos("Computer Cost:",buff,j+1) j=pos(d2c(13),buff,i) line.3=strip(substr(buff,i,j-i)) parse var line.3 . . computercost . . . turnsperwarp . . defensiveodds . computercost=_stripcomma(computercost) defensiveodds=_dword(defensiveodds,1,":") i=pos("Ship Hull Cost:",buff,j+1) j=pos(d2c(13),buff,i) line.4=strip(substr(buff,i,j-i)) parse var line.4 . . . shiphullcost . . minemax . . beaconmax . shiphullcost=_stripcomma(shiphullcost) i=pos("Ship Base Cost:",buff,j+1) j=pos(d2c(13),buff,i) line.5=strip(substr(buff,i,j-i)) parse var line.5 . . . shipbasecost . . genesismax . . . longrangescan . shipbasecost=_stripcomma(shipbasecost) longrangescan=pos("Y",longrangescan) i=pos("Max Figs Per Attack:",buff,j+1) j=pos(d2c(13),buff,i) line.6=strip(substr(buff,i,j-i)) parse var line.6 . . . . maxfigsperattack . . transwarpdrive . . planetscanner . maxfigsperattack=_stripcomma(maxfigsperattack) transwarpdrive=pos("Y",transwarpdrive) planetscanner=pos("Y",planetscanner) i=pos("Maximum Holds:",buff,j+1) j=pos(d2c(13),buff,i) line.7=strip(substr(buff,i,j-i)) parse var line.7 . . maximumholds . . transportrange . . photonmissiles . photonmissiles=pos("Y",photonmissiles) rslt=shipbasecost maxfigsperattack maximumholds initialholds maxfighters turnsperwarp minemax genesismax , transwarpdrive transportrange maximumshields offensiveodds defensiveodds beaconmax longrangescan , planetscanner photonmissiles rslt=translate(rslt,";"," ") return rslt /* Which ship are you interested in (?=List) ? You shut off the Vid Term. Computer command [TL=00:00:00]:[3156] (?=Help)? ; Corporate FlagShip Basic Hold Cost: 10,000 Initial Holds: 20 Maximum Shields: 1,500 Main Drive Cost: 5,000 Max Fighters: 20,000 Offensive Odds: 1.2:1 Computer Cost: 120,000 Turns Per Warp: 3 Defensive Odds: 1.2:1 Ship Hull Cost: 28,500 Mine Max: 100 Beacon Max: 100 Ship Base Cost: 163,500 Genesis Max: 10 Long Range Scan: Yes Max Figs Per Attack: 6000 TransWarp Drive: Yes Planet Scanner: Yes Maximum Holds: 85 Transport Range: 10 Photon Missiles: No Computer command [TL=00:00:00]:[3156] (?=Help)? */ /** _stripcomma v.1 **/ _stripcomma: procedure expose (globals) rslt=translate(_space(translate(arg(1),", "," ,"),0)," ",",") return rslt